home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbaccbmp / oleacces.bas < prev    next >
Encoding:
BASIC Source File  |  1995-09-06  |  6.3 KB  |  195 lines
  1. '**********************************************************************
  2. '* OLEACCES.BAS
  3. '*
  4. '* Contains support functions for data access.
  5. '*
  6. '* DisplayOLEBitmap    -  Displays a bitmap stored in an Access database
  7. '*                        in a VB picture control.
  8. '* CopyOLEBitmapToFile -  Used by DisplayOLEBitmap.
  9. '*
  10. '**********************************************************************
  11. Option Explicit
  12.  
  13. Global Const LENGTH_FOR_SIZE = 4
  14. Global Const OBJECT_SIGNATURE = &H1C15
  15. Global Const OBJECT_HEADER_SIZE = 20
  16. Global Const CHECKSUM_SIGNITURE = &HFE05AD00
  17. Global Const CHECKSUM_STRING_SIZE = 4
  18.  
  19. 'PT : Window sizing information for object
  20. '     Used in OBJECTHEADER type
  21. Type PT
  22.    Width As Integer
  23.    Height As Integer
  24. End Type
  25.  
  26. 'OBJECTHEADER : Contains relevant information about object
  27. '
  28. Type OBJECTHEADER
  29.    Signature As Integer         'Type signature (0x1c15)
  30.    HeaderSize As Integer        'Size of header (sizeof(struct
  31.                                 'OBJECTHEADER) + cchName +
  32.                                 'cchClass)
  33.    ObjectType As Long           'OLE Object type code (OT_STATIC,
  34.                                 'OT_LINKED, OT_EMBEDDED)
  35.    NameLen As Integer           'Count of characters in object
  36.                                 'name (CchSz(szName) + 1)
  37.    ClassLen As Integer          'Count of characters in class
  38.                                 'name (CchSz(szClass) + 1)
  39.    NameOffset As Integer        'Offset of object name in
  40.                                 'structure (sizeof(OBJECTHEADER))
  41.    ClassOffset As Integer       'Offset of class name in
  42.                                 'structure (ibName + cchName)
  43.    ObjectSize As PT             'Original size of object (see
  44.                                 'code below for value)
  45.    OleInfo As String * 256
  46. End Type
  47.  
  48. Type OLEHEADER
  49.    OleVersion As Long
  50.    Format As Long
  51.    OleInfo As String * 512
  52. End Type
  53.  
  54. 'Enter the following Declare statement as one, single line:
  55. Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer, ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal lpTempFileName As String) As Integer
  56.  
  57. 'Enter the following Declare statement as one, single line:
  58. Declare Sub hmemcpy Lib "Kernel" (dest As Any, source As Any, ByVal bytes As Long)
  59.  
  60. '**********************************************************************
  61. '* Title
  62. '*      CopyOleBitmapToFile
  63. '*
  64. '* Description
  65. '*      Copies the bitmap contained in a OLE field to a file.
  66. '**********************************************************************
  67. Function CopyOleBitmapToFile (OleField As Field) As String
  68.  
  69.    Const BUFFER_SIZE = 8192
  70.  
  71.    Dim tempFileName As String
  72.    Dim Handle As Integer
  73.    Dim Buffer As String
  74.  
  75.    Dim BytesNeeded As Long
  76.  
  77.    Dim Buffers As Long
  78.    Dim Remainder As Long
  79.  
  80.    Dim OLEHEADER As OBJECTHEADER
  81.    Dim sOleHeader As String
  82.  
  83.    Dim ObjectOffset As Long
  84.    Dim BitmapOffset As Long
  85.    Dim BitmapHeaderOffset As Integer
  86.  
  87.    Dim r As Integer
  88.    Dim i As Long
  89.  
  90.    tempFileName = ""
  91.    If OleField.FieldSize() > OBJECT_HEADER_SIZE Then
  92.  
  93.       'Get the Microsoft Access OLE header:
  94.       sOleHeader = OleField.GetChunk(0, OBJECT_HEADER_SIZE)
  95.       hmemcpy OLEHEADER, ByVal sOleHeader, OBJECT_HEADER_SIZE
  96.  
  97.       'Calculate the offset where the OLE object starts:
  98.       ObjectOffset = OLEHEADER.HeaderSize + 1
  99.  
  100.       'Get enough bytes after the OLE header so that we get the
  101.       'bitmap header
  102.       Buffer = OleField.GetChunk(ObjectOffset, 512)
  103.  
  104.       'Make sure the class of the object is a Paint Brush object
  105.       If Mid(Buffer, 12, 6) = "PBrush" Then
  106.  
  107.          BitmapHeaderOffset = InStr(Buffer, "BM")
  108.  
  109.          If BitmapHeaderOffset > 0 Then
  110.  
  111.             'Calculate the beginning of the bitmap:
  112.             BitmapOffset = ObjectOffset + BitmapHeaderOffset - 1
  113.  
  114.             'Calculate the size of the bitmap:
  115.             'Enter the following BytesNeeded statement as a single line:
  116.             BytesNeeded = OleField.FieldSize() - OBJECT_HEADER_SIZE - BitmapHeaderOffset - CHECKSUM_STRING_SIZE + 1
  117.  
  118.             'Calculate the number of buffers needed to copy
  119.             'the OLE object based on the bitmap size:
  120.             Buffers = BytesNeeded \ BUFFER_SIZE
  121.             Remainder = BytesNeeded Mod BUFFER_SIZE
  122.  
  123.             'Get a unique, temp filename:
  124.             tempFileName = Space(255)
  125.             r = GetTempFileName(0, "", -1, tempFileName)
  126.  
  127.             'Copy the bitmap to the temporary file chunk by chunk:
  128.             Handle = FreeFile
  129.             Open tempFileName For Binary As #Handle
  130.  
  131.             For i = 0 To Buffers - 1
  132.                'Enter the following Buffer statement as a single line:
  133.                Buffer = OleField.GetChunk(BitmapOffset + i * BUFFER_SIZE, BUFFER_SIZE)
  134.                Put #Handle, , Buffer
  135.             Next
  136.  
  137.             'Copy the remaining chunk of the bitmap to the file:
  138.             'Enter the following Buffer statement as a single line:
  139.             Buffer = OleField.GetChunk(BitmapOffset + Buffers * BUFFER_SIZE, Remainder)
  140.             Put #Handle, , Buffer
  141.  
  142.             Close #Handle
  143.  
  144.          End If
  145.  
  146.       End If
  147.  
  148.    End If
  149.  
  150.    CopyOleBitmapToFile = Trim(tempFileName)
  151.  
  152. End Function
  153.  
  154. '**********************************************************************
  155. '* Title
  156. '*      DisplayOleBitmap
  157. '*
  158. '* Description
  159. '*      Causes the OLE bitmap in the given data field to be
  160. '*      copied to a temporary file. The bitmap is then
  161. '*      displayed in the given picture.
  162. '*
  163. '* Parameters
  164. '*      ctlPict         Picture control in which to display the
  165. '*                      bitmap image
  166. '*      OleField        Database field containing the OLE
  167. '*                      embedded Microsoft Paint Brush bitmap
  168. '**********************************************************************
  169. Sub DisplayOleBitmap (ctlPict As Control, OleField As Field)
  170.  
  171.    Const DT_LONGBINARY = 11
  172.  
  173.    Dim r As Integer
  174.    Dim Handle As Integer
  175.    Dim OleFileName As String
  176.  
  177.    If OleField.Type = DT_LONGBINARY Then
  178.  
  179.       OleFileName = CopyOleBitmapToFile(OleField)
  180.  
  181.       If OleFileName <> "" Then
  182.  
  183.          'Display the bitmap:
  184.          picTest.picImage.Picture = LoadPicture(OleFileName)
  185.  
  186.          'Delete the temporary file:
  187.          Kill OleFileName
  188.  
  189.       End If
  190.  
  191.    End If
  192.  
  193. End Sub
  194.  
  195.